home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Text / Emacs-1.12d folder / lisp / mac / clipboard.el < prev    next >
Encoding:
Text File  |  1993-12-28  |  1.9 KB  |  69 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; This file is part of a Macintosh port of GNU Emacs.
  3. ;;; Copyright (C) 1993 Marc Parmet.  All rights reserved.
  4. ;;;
  5. ;;; Clipboard support functions
  6. ;;;
  7.  
  8. (defvar clipboard-name "*clipboard*")
  9. (defvar clipboard-previous-scrapcount -1)
  10.  
  11. (defun clipboard-current-scrapcount ()
  12.   (extract-internal (InfoScrap) 8 2 nil))
  13.  
  14. (defun string-to-scrap (s)
  15.   (ZeroScrap)
  16.   (PutScrap (length s) "TEXT" s))
  17.  
  18. (defun scrap-to-string ()
  19.   (let* ((h (NewHandle 0))
  20.          (offset (make-string 4 0))
  21.          (length (GetScrap h "TEXT" offset)))
  22.     (if (< length 0)
  23.         length
  24.       (HLock h)
  25.       (let ((s (make-init-string (deref h) length)))
  26.         (DisposHandle h)
  27.         s))))
  28.  
  29. (defun get-clipboard-buffer ()
  30.   (let ((clipboard (get-buffer-create clipboard-name)))
  31.     (set-buffer clipboard)
  32.     (if (not buffer-read-only)
  33.         (toggle-read-only))
  34.     clipboard))
  35.  
  36. ;;; Response to the Copy command
  37. (defun copy-region-to-clipboard ()
  38.   (let* ((old-buffer (current-buffer))
  39.          (s (buffer-substring (point) (mark)))
  40.          (clipboard (get-clipboard-buffer)))
  41.     (set-buffer clipboard)
  42.     (toggle-read-only)
  43.     (erase-buffer)
  44.     (insert s)
  45.     (subst-char-in-region (point-min) (point-max) 10 13 t)
  46.     (string-to-scrap (buffer-string))
  47.     (subst-char-in-region (point-min) (point-max) 13 10 t)
  48.     (toggle-read-only)
  49.     (set-buffer old-buffer)))
  50.  
  51. ;;; The C code that handle activate events looks for this function by name
  52. ;;; to make sure the clipboard has the current contents of the Scrap.
  53. (defun make-clipboard-current ()
  54.   (let* ((old-buffer (current-buffer))
  55.          (clipboard (get-clipboard-buffer)))
  56.     (if (not (= (clipboard-current-scrapcount) clipboard-previous-scrapcount))
  57.         (let ((s (scrap-to-string)))
  58.           (if (stringp s)
  59.               (progn
  60.                 (set-buffer clipboard)
  61.                 (toggle-read-only)
  62.                 (erase-buffer)
  63.                 (insert s)
  64.                 (subst-char-in-region (point-min) (point-max) 13 10 t)
  65.                 (toggle-read-only)
  66.                 (setq clipboard-previous-scrapcount (clipboard-current-scrapcount))))))
  67.     (set-buffer old-buffer)
  68.     clipboard))
  69.